home *** CD-ROM | disk | FTP | other *** search
/ Floppyshop 2 / Floppyshop - 2.zip / Floppyshop - 2.iso / art&graf.ix / art-0012 / shendraw / shendraw.pas next >
Pascal/Delphi Source File  |  1997-04-16  |  40KB  |  1,179 lines
  1. PROGRAM Menu_Example ;
  2.  
  3. CONST
  4.     {$I gemconst}
  5.  
  6. TYPE
  7.     {$I gemtype}
  8.  
  9.     letter_num  = string[4];
  10.     pos_actions = (nothing, point_action, line_action, rect_action,
  11.                    rd_rect_action, circle_action,
  12.                    text_action, preset_action, insert_action);
  13.  
  14.  
  15. VAR
  16.  
  17.       menu : Menu_Ptr ;
  18.  
  19.       file_title,
  20.         open_item,
  21.         load_item,
  22.         save_item,
  23.         close_item,
  24.         fsep_item,
  25.         quit_item,
  26.  
  27.      actions_title,
  28.         point_item,
  29.         line_item,
  30.         rect_item,
  31.         rd_rect_item,
  32.         circle_item,
  33.         text_item,
  34.         preset_item,
  35.         asep0_item,
  36.         insert_item,
  37.         nothing_item,
  38.         asep1_item,
  39.         showxy_item,
  40.         grid_item,
  41.         asep2_item,
  42.         erase_item         : integer;
  43.  
  44.       predef_title         : integer;
  45.         square_item,
  46.         pcircle_item,
  47.         arrow_item         : array [1..3] of integer;
  48.  
  49.       mode_title,
  50.          frame_item,
  51.          fill_item,
  52.          msep0_item,
  53.          black_item,
  54.          white_item,
  55.          red_item,
  56.          green_item,
  57.          msep1_item,
  58.          out_true_item,
  59.          out_false_item,
  60.          msep2_item,
  61.          replace_item,
  62.          transp_item,
  63.          xor_item,
  64.          reverse_item,
  65.  
  66.        text_title,
  67.          normal_item,
  68.          bold_item,
  69.          italic_item,
  70.          under_item,
  71.          outline_item,
  72.          shadow_item,
  73.  
  74.        line_title,
  75.          solid_item,
  76.          longdash_item,
  77.          dots_item,
  78.          ddots_item,
  79.          dash_item,
  80.          ddd_item,
  81.  
  82.       paintstyle_title,
  83.          m1_item,
  84.          m2_item,
  85.          m3_item,
  86.          m4_item,
  87.          m5_item,
  88.          m6_item,
  89.          m7_item,
  90.          psep1_item,
  91.          n1_item,
  92.          n2_item,
  93.          n3_item,
  94.          n4_item,
  95.          n5_item,
  96.  
  97.       wind_title     : integer;
  98.          wind_item   : array [1..4] of integer;
  99.  
  100.  
  101.  
  102.       dummy          : integer ;
  103.  
  104.       actions        : pos_actions;
  105.  
  106.  
  107.       start_figure,
  108.       b_showxy,
  109.  
  110.       b_normal,
  111.       b_bold,
  112.       b_italic,
  113.       b_under,
  114.       b_outline,
  115.       b_shadow,
  116.  
  117.       b_save,
  118.       b_frame        : boolean;
  119.  
  120.       b_arrow,
  121.       b_square,
  122.       b_pcircle      : array [1..5] of boolean;
  123.  
  124.       b_shapes       : array [1..12] of boolean;
  125.  
  126.       draw_type,
  127.       draw_window    : array [1..4] of integer;
  128.       g_info_bar,
  129.       draw_title     : window_title;
  130.  
  131.       act_window     : integer;
  132.  
  133.       x, y, w, h,
  134.       curx, cury,
  135.       oldx, oldy     : integer;
  136.  
  137.       alert          : string;
  138.  
  139.       cur_outline    : boolean;
  140.       mul,
  141.       mul_number,
  142.       cur_paint_style,
  143.       cur_line_style,
  144.       cur_text_style,
  145.       cur_color,
  146.       cur_font,
  147.       cur_draw_mode  : integer;
  148.  
  149.       preset_string  : string;
  150.       copyright      : str255;
  151.  
  152.       screen_w, screen_h,
  153.       total_cols, total_rows,
  154.       char_width, char_heigth,
  155.       col, row,
  156.       first_col, first_row,
  157.       xy_col
  158.                      : integer;
  159.  
  160.       xm, ym         : integer;
  161.  
  162.  
  163. { memory of parameters at all times
  164.   1  what action is taking place        : actions (set of ...)
  165.   2  if predef what predefined figure   :
  166.   4  user strings if any                : user_string
  167.   5  modes : frame or fill              : b_frame (true or false)
  168.   6          black or white             : cur_color (black or white)
  169.   7          outline true or false      : cur_outline (true or false)
  170.   8          what draw_mode (1-4)       : cur_draw_mode (1 to 4)
  171.   9          text mode (1-6)            : cur_text_style( 1 to 6)
  172.  10          line style (1-6)           : cur_line_style (1 to 6)
  173.  11          painstyle (1-35)           : cur_paint_style( 1 to 35)
  174. }
  175.  
  176.     {$I gemsubs}
  177.  
  178.  
  179. procedure TAOLOGO;
  180. var
  181.         i, limit, maxi,
  182.         midx, midy,
  183.         tao_radius,
  184.         midy_up,
  185.         midy_dn,
  186.         radius2,
  187.         radius3 : integer;
  188.         x,y,w,h,
  189.         mid_screen_x,
  190.         vertical : integer;
  191.  
  192.   procedure WAIT(n : integer);
  193.   var i, j : integer;
  194.   begin
  195.       for i := 1 to n do
  196.         for j := 1 to 32000 do;
  197.   end;
  198.  
  199. begin
  200.      {   clear_screen;  }
  201.  
  202.         limit := 0;
  203.         maxi := 10;
  204.  
  205.         draw_mode(1);
  206.         paint_style(solid);
  207.         work_rect(0,x,y,w,h);
  208.         set_clip(0,0,w,h+y);
  209.         mid_screen_x := w div 2;
  210.         vertical := h+y;
  211.  
  212.         for i := 1 to maxi do
  213.         begin
  214.          clear_screen;
  215.          tao_radius := i * (100 div maxi);
  216.          tao_radius := tao_radius div 2;
  217.          midx := (mid_screen_x div maxi) * i;
  218.          midy := vertical - (( (vertical div 8 * 5) div maxi ) * i);
  219.          midy_up := midy - (tao_radius div 2);
  220.          midy_dn := midy + (tao_radius div 2);
  221.          radius2 := tao_radius div 2;
  222.          radius3 := radius2 div 2;
  223.  
  224.  
  225.         frame_oval (midx, midy, tao_radius, tao_radius);
  226.         frame_oval (midx, midy, tao_radius+1, tao_radius+1);
  227.  
  228.         paint_color( black );
  229.         paint_arc (midx, midy, tao_radius, tao_radius, 2700, 3600 );
  230.         paint_arc (midx, midy, tao_radius, tao_radius, 0, 900 );
  231.  
  232.         paint_color( white );
  233.         paint_oval (midx, midy_up, radius2, radius2);
  234.  
  235.         paint_color( black );
  236.         paint_oval (midx, midy_dn, radius2, radius2);
  237.  
  238.         paint_color( black );
  239.         paint_oval (midx, midy_up, radius3, radius3);
  240.  
  241.         paint_color( white );
  242.         paint_oval (midx, midy_dn, radius3, radius3);
  243.       end; { for }
  244.  
  245.         wait(3);
  246.         text_style(thickened|underlined);
  247.         draw_string( 190, vertical div 40 * 33,
  248.          ' S  H  E  N    D  R  A  W  E  R ');
  249.         wait(3);
  250.         text_style(outlined);
  251.         draw_string( 110, vertical div 40 * 36,
  252.                     'Something Else Inc.  Mirissa   Sri Lanka');
  253.         wait(10);
  254.         text_style(normal);
  255. end;
  256.  
  257. procedure INT_TO_STR(num : integer; VAR numstr : letter_num);
  258. { transforms an integer in a 3-character string }
  259. var n : integer;
  260.     a,b,c,dummy : char;
  261.  
  262.   procedure first;
  263.   begin
  264.       a := '0';
  265.       b := '0';
  266.       c := chr(ord(num) + 48);
  267.   end;
  268.   procedure second;
  269.   begin
  270.       a := '0';
  271.       b := chr(ord(num div 10)+ 48);
  272.       c := chr(ord(num mod 10)+ 48);
  273.   end;
  274.   procedure third;
  275.   begin
  276.       a := chr(ord(num div 100)+ 48);
  277.       n := num mod 100;
  278.       b := chr(ord(n div 10)+ 48);
  279.       c := chr(ord(n mod 10)+ 48);
  280.   end;
  281.  
  282. begin
  283.         if num < 10
  284.         then first
  285.         else if num < 100
  286.              then second
  287.              else if num < 1000
  288.                   then third;
  289.         numstr := concat(a,b,c);
  290. end;
  291.  
  292. procedure ALERTBOX(str : str255);
  293. var alert : str255;
  294. begin
  295.        alert := concat ('[0][', str, '][ OK ]');
  296.        dummy := do_alert( alert, 1 ) ;
  297.        set_mouse(m_thin_cross);
  298. end;
  299.  
  300. procedure SCREEN_CHAR_PARAM(win_handle : integer);
  301. var x, y, w, h, cw, ch, dummy : integer;
  302. begin
  303.       sys_font_size(cw, ch, dummy, dummy);
  304.       char_width := cw;
  305.       char_heigth := ch;
  306.       work_rect(  win_handle, x, y, w, h ) ;
  307.       screen_w := w;
  308.       screen_h := h;
  309.       total_cols := screen_w div char_width;
  310.       total_rows := screen_h div char_heigth;
  311.  
  312.       first_row := y + char_heigth;
  313.       first_col := x;
  314.       xy_col := screen_w - (12 * char_width);
  315. end;
  316.  
  317. procedure CLEAR_WINDOW(win_handle : INTEGER);
  318. var x, y, w, h : integer;
  319. begin
  320.      hide_mouse;
  321.        work_rect( win_handle, x, y, w, h ) ;
  322.        set_clip( x, y, w, h ) ;
  323.        draw_mode(1);
  324.        paint_style( solid ) ;
  325.        paint_color( white ) ;
  326.        paint_rect( x, y, w, h ) ;
  327.  
  328.        draw_mode( cur_draw_mode );
  329.        paint_style( cur_paint_style ) ;
  330.        paint_color ( cur_color );
  331.      show_mouse;
  332. end;
  333.  
  334. function DECODE_KEY( key_word : integer) : char;
  335. var i, kw, char_value : integer;
  336. begin
  337.      kw := key_word & $00FF;
  338.  
  339.      for i := 32 to 128 do
  340.           if kw & i = i
  341.           then  char_value := i;
  342.      decode_key := chr(char_value);
  343. end;
  344.  
  345. procedure DEF_WINDOW;
  346. var i : integer;
  347. begin
  348.         draw_type[1] := g_close|g_name;
  349.         draw_type[2] := draw_type[1]|g_uparrow|g_dnarrow;
  350.         draw_type[3] := g_all;
  351.         draw_type[4] := g_all|g_info;
  352.         draw_title  := '  SHEN RISING DRAW AND PAINT PROGRAM  ';
  353.         g_info_bar  := '  This is the info bar  ';
  354.         draw_window[1] := New_Window(draw_type[1], draw_title, 0,0,0,0);
  355.         draw_window[2] := New_Window(draw_type[2], draw_title, 0,0,0,0);
  356.         draw_window[3] := New_Window(draw_type[3], draw_title, 0,0,0,0);
  357.         draw_window[4] := New_Window(draw_type[4], draw_title, 0,0,0,0);
  358.         set_winfo(draw_window[4], g_info_bar);
  359. end;
  360.  
  361. function SWITCH(var b : boolean) : boolean;
  362. begin
  363.        if b = true
  364.        then b := false
  365.        else b := true;
  366.        switch := b;
  367. end;
  368.  
  369. procedure SENTENCES;
  370. var s : array [1..5] of string[30];
  371. begin
  372.         s[1] := 'SHEN RISING DRAW PROGRAM|';
  373.         s[2] := ' Public Domain Software |';
  374.         s[3] := '    by  Georges Khal    |';
  375.         s[4] := '   Something Else Inc.  |';
  376.         s[5] := ' Mirissa, Sri Lanka 1986';
  377.         copyright := concat(s[1], s[2], s[3], s[4], s[5]);
  378.         preset_string := 'This is a preset sentence to display';
  379. end;
  380.  
  381. procedure DEF_MENU1;
  382. begin
  383.         menu := New_Menu( 100, '  SHEN DRAW ');
  384.  
  385.         file_title       := Add_MTitle( menu, ' File ');
  386.         actions_title    := Add_MTitle( menu, ' Figures ');
  387.         predef_title     := Add_MTitle( menu, ' Predef. ');
  388.         mode_title       := Add_MTitle( menu, ' Mode ');
  389.         text_title       := Add_MTitle( menu, ' Text_St. ');
  390.         line_title       := Add_MTitle( menu, ' Line_St. ');
  391.         paintstyle_title := Add_MTitle( menu, ' Paint_St. ');
  392.         wind_title       := Add_MTitle( menu, ' WindType ');
  393.  
  394.         save_item   := Add_MItem( menu, file_title, '  Save  ');
  395.         fsep_item   := Add_MItem( menu, file_title, '--------');
  396.         quit_item   := Add_MItem( menu, file_title, '  Quit  ');
  397.  
  398.         point_item     := Add_MItem( menu, actions_title, '  Point     ');
  399.         line_item      := Add_MItem( menu, actions_title, '  Line      ');
  400.         rect_item      := Add_MItem( menu, actions_title, '  Rectangle ');
  401.         rd_rect_item   := Add_MItem( menu, actions_title, '  Rnd Rect. ');
  402.         circle_item    := Add_MItem( menu, actions_title, '  Circle    ');
  403.         text_item      := Add_MItem( menu, actions_title, '  Text      ');
  404.         preset_item    := Add_MItem( menu, actions_title, '  PreText   ');
  405.         nothing_item   := Add_MItem( menu, actions_title, '  Nothing   ');
  406.         asep0_item     := Add_MItem( menu, actions_title, '------------');
  407.         insert_item    := Add_MItem( menu, actions_title, '  Insert    ');
  408.         asep1_item     := Add_MItem( menu, actions_title, '------------');
  409.         showxy_item    := Add_MItem( menu, actions_title, '  Show x y  ');
  410.         grid_item      := Add_MItem( menu, actions_title, '  Grid      ');
  411.         asep2_item     := Add_MItem( menu, actions_title, '------------');
  412.         erase_item     := Add_MItem( menu, actions_title, '  Erase Scr ');
  413.  
  414.         square_item[1]  := Add_MItem( menu, predef_title, '  Square1 ');
  415.         square_item[2]  := Add_MItem( menu, predef_title, '  Square2 ');
  416.         square_item[3]  := Add_MItem( menu, predef_title, '  Square3 ');
  417.         pcircle_item[1] := Add_MItem( menu, predef_title, '  Circle1 ');
  418.         pcircle_item[2] := Add_MItem( menu, predef_title, '  Circle2 ');
  419.         pcircle_item[3] := Add_MItem( menu, predef_title, '  Circle3 ');
  420.         arrow_item[1]   := Add_MItem( menu, predef_title, '  Arrow1  ');
  421.         arrow_item[2]   := Add_MItem( menu, predef_title, '  Arrow2  ');
  422.         arrow_item[3]   := Add_MItem( menu, predef_title, '  Arrow3  ');
  423.  
  424. end;
  425.  
  426. procedure DEF_MENU2;
  427. begin
  428.         frame_item     := Add_MItem( menu, mode_title,  '  Frame   ');
  429.         fill_item      := Add_MItem( menu, mode_title,  '  Fill    ');
  430.         msep0_item     := Add_MItem( menu, mode_title,  '----------');
  431.         black_item     := Add_MItem( menu, mode_title,  '  Black   ');
  432.         white_item     := Add_MItem( menu, mode_title,  '  White   ');
  433.         red_item       := Add_MItem( menu, mode_title,  '  Red     ');
  434.         green_item     := Add_MItem( menu, mode_title,  '  Green   ');
  435.         msep1_item     := Add_MItem( menu, mode_title,  '----------');
  436.         out_true_item  := Add_MItem( menu, mode_title,  '  Outl Tr ');
  437.         out_false_item := Add_MItem( menu, mode_title,  '  Outl Fa ');
  438.         msep2_item     := Add_MItem( menu, mode_title,  '----------');
  439.         replace_item   := Add_MItem( menu, mode_title,  '  Replace ');
  440.         transp_item    := Add_MItem( menu, mode_title,  '  Transp. ');
  441.         xor_item       := Add_MItem( menu, mode_title,  '  Xor     ');
  442.         reverse_item   := Add_MItem( menu, mode_title,  '  Reverse ');
  443.  
  444.         normal_item    := Add_MItem( menu, text_title,  '  Normal   ');
  445.         bold_item      := Add_MItem( menu, text_title,  '  Bold     ');
  446.         italic_item    := Add_MItem( menu, text_title,  '  Italic   ');
  447.         under_item     := Add_MItem( menu, text_title,  '  Underl.  ');
  448.         outline_item   := Add_MItem( menu, text_title,  '  Outlined ');
  449.         shadow_item    := Add_MItem( menu, text_title,  '  Shadow   ');
  450.  
  451.         solid_item     := Add_MItem( menu, line_title,  '  Solid    ');
  452.         longdash_item  := Add_MItem( menu, line_title,  '  Lg Dash  ');
  453.         dots_item      := Add_MItem( menu, line_title,  '  Dotted   ');
  454.         ddots_item     := Add_MItem( menu, line_title,  '  DashDot  ');
  455.         dash_item      := Add_MItem( menu, line_title,  '  Dashed   ');
  456.         ddd_item       := Add_MItem( menu, line_title,  '  DashDtDt ');
  457.  
  458.         m1_item    := Add_MItem( menu, paintstyle_title, '  01 - 05 ');
  459.         m2_item    := Add_MItem( menu, paintstyle_title, '  06 - 10 ');
  460.         m3_item    := Add_MItem( menu, paintstyle_title, '  11 - 15 ');
  461.         m4_item    := Add_MItem( menu, paintstyle_title, '  16 - 20 ');
  462.         m5_item    := Add_MItem( menu, paintstyle_title, '  21 - 25 ');
  463.         m6_item    := Add_MItem( menu, paintstyle_title, '  26 - 30 ');
  464.         m7_item    := Add_MItem( menu, paintstyle_title, '  31 - 35 ');
  465.         psep1_item := Add_MItem( menu, paintstyle_title, '----------');
  466.         n1_item    := Add_MItem( menu, paintstyle_title, '  + 0     ');
  467.         n2_item    := Add_MItem( menu, paintstyle_title, '  + 1     ');
  468.         n3_item    := Add_MItem( menu, paintstyle_title, '  + 2     ');
  469.         n4_item    := Add_MItem( menu, paintstyle_title, '  + 3     ');
  470.         n5_item    := Add_MItem( menu, paintstyle_title, '  + 4     ');
  471.  
  472.         wind_item[1]  := Add_MItem( menu, wind_title, '  Window1 ');
  473.         wind_item[2]  := Add_MItem( menu, wind_title, '  Window2 ');
  474.         wind_item[3]  := Add_MItem( menu, wind_title, '  Window3 ');
  475.         wind_item[4]  := Add_MItem( menu, wind_title, '  Window4 ');
  476.  
  477. end;
  478.  
  479. procedure DEF_MENU3;
  480. var i : integer;
  481. begin
  482.         menu_disable (menu,     fsep_item);
  483.         menu_disable (menu,    asep0_item);
  484.         menu_disable (menu,    asep1_item);
  485.         menu_disable (menu,    asep2_item);
  486.         menu_disable (menu,    msep0_item);
  487.         menu_disable (menu,    msep1_item);
  488.         menu_disable (menu,    msep2_item);
  489.  
  490.         menu_check   (menu,    point_item, true);
  491.         menu_check   (menu,   square_item[1], true);
  492.         menu_check   (menu,    frame_item, true);
  493.         menu_check   (menu,    black_item, true);
  494.         menu_check   (menu, out_true_item, true);
  495.         menu_check   (menu,  replace_item, true);
  496.         menu_check   (menu,   normal_item, true);
  497.         menu_check   (menu,    solid_item, true);
  498.         menu_check   (menu,       m1_item, true);
  499.         menu_check   (menu,       n1_item, true);
  500.         menu_check   (menu,  wind_item[1], true);
  501. end;
  502.  
  503.  
  504. PROCEDURE DEFINITIONS;
  505. begin
  506.       def_menu1;
  507.       def_menu2;
  508.       def_menu3;
  509.       sentences;
  510. end;
  511.  
  512. procedure ADJUST_PARAM;
  513. begin
  514.      text_color(   cur_color);
  515.      line_color(   cur_color);
  516.      paint_color(  cur_color);
  517.      draw_mode(    cur_draw_mode);
  518.      text_style(   cur_text_style);
  519.      line_style(   cur_line_style);
  520.      paint_outline(cur_outline);
  521.      paint_style(  cur_paint_style);
  522. end;
  523.  
  524. procedure INIT_PARAM;
  525. var i : integer;
  526. begin
  527.      cur_color := black;
  528.      cur_draw_mode := 1;
  529.      cur_text_style := normal;
  530.      cur_line_style := 1;
  531.      cur_outline := true;
  532.      cur_paint_style := 1;
  533.      cur_font := system_font;
  534.  
  535.      actions := point_action;
  536.      b_frame := true;
  537.      b_save := false;
  538.  
  539.      b_showxy := false;
  540.        b_square[1] := true;
  541.      for i := 2 to 3 do
  542.        b_square[i] := false;
  543.      for i := 1 to 3 do
  544.      b_pcircle[i] := false;
  545.      for i := 1 to 3 do
  546.      b_arrow[i] := false;
  547.  
  548.      adjust_param;
  549. end;
  550.  
  551. procedure DO_GRID(win_handle : integer);
  552. var x, y, w, h : integer;
  553. begin
  554.      hide_mouse;
  555.      draw_mode(3);
  556.      paint_style(31);
  557.      paint_color( black ) ;
  558.  
  559.      work_rect( win_handle, x, y, w, h ) ;
  560.      set_clip( x, y, w, h ) ;
  561.      paint_rect( x, y, w, h ) ;
  562.  
  563.      paint_color(cur_color);
  564.      paint_style(cur_paint_style);
  565.      draw_mode(  cur_draw_mode);
  566.      show_mouse;
  567. end;
  568.  
  569. procedure SET_FILE_TITLE(item : integer);
  570. begin
  571.      if item = save_item
  572.      then start_figure := true;
  573. end;
  574.  
  575. procedure SET_ACTIONS_TITLE(item, x, y : integer);
  576. var s : string[11];
  577. begin
  578.              if item = erase_item
  579.              then begin
  580.                     clear_window(draw_window[act_window]);
  581.                     adjust_param;
  582.                   end
  583.              else if item = showxy_item
  584.                   then begin
  585.                          if b_showxy
  586.                          then begin
  587.                                 draw_mode(1);
  588.                                 s := '           ';
  589.                                 draw_string(xy_col, first_row, s);
  590.                                 draw_mode(cur_draw_mode);
  591.                               end;
  592.                          menu_check(menu, showxy_item, switch(b_showxy));
  593.                        end
  594.                   else if item = grid_item
  595.                        then do_grid(draw_window[act_window])
  596.                        else
  597.                        begin
  598.                          menu_check(menu,   point_item, false);
  599.                          menu_check(menu,    line_item, false);
  600.                          menu_check(menu,    rect_item, false);
  601.                          menu_check(menu, rd_rect_item, false);
  602.                          menu_check(menu,  circle_item, false);
  603.                          menu_check(menu,    text_item, false);
  604.                          menu_check(menu,  preset_item, false);
  605.                          menu_check(menu,  insert_item, false);
  606.                          menu_check(menu, nothing_item, false);
  607.                          menu_check(menu, item, true);
  608.  
  609.                          if item = point_item
  610.                          then actions := point_action;
  611.                          if item = line_item
  612.                          then begin
  613.                                 actions := line_action;
  614.                                { oldx := x; oldy := y; }
  615.                               end;
  616.                          if item = rect_item
  617.                          then actions := rect_action;
  618.                          if item = rd_rect_item
  619.                          then actions := rd_rect_action;
  620.                          if item = circle_item
  621.                          then actions := circle_action;
  622.                          if item = text_item
  623.                          then actions := text_action;
  624.                          if item = preset_item
  625.                          then actions := preset_action;
  626.                          if item = insert_item
  627.                          then actions := insert_action;
  628.                          if item = nothing_item
  629.                          then actions := nothing;
  630.  
  631.                          if actions in [ line_action, rect_action,
  632.                                          rd_rect_action, circle_action]
  633.                          then start_figure := true;
  634.  
  635.                        end; { else }
  636.  
  637. end; { if action_title }
  638.  
  639. procedure SET_PREDEF_TITLE(item : integer);
  640. var i : integer;
  641. begin
  642.              for i := 1 to 3 do
  643.                menu_check(menu,  square_item[i], false);
  644.              for i := 1 to 3 do
  645.                menu_check(menu, pcircle_item[i], false);
  646.              for i := 1 to 3 do
  647.                menu_check(menu,   arrow_item[i], false);
  648.              menu_check(menu, item, true);
  649.              for i := 1 to 3 do
  650.                b_square[i] := false;
  651.              for i := 1 to 3 do
  652.                b_pcircle[i] := false;
  653.              for i := 1 to 3 do
  654.                b_arrow[i] := false;
  655.              for i := 1 to 3 do
  656.                if item = square_item[i]
  657.                then b_square[i] := true;
  658.              for i := 1 to 3 do
  659.                if item = pcircle_item[i]
  660.                then b_pcircle[i] := true;
  661.              for i := 1 to 3 do
  662.                if item = arrow_item[i]
  663.                then b_arrow[i] := true;
  664. end;
  665.  
  666. procedure SET_MODE_TITLE(item : integer);
  667. begin
  668.            if (item = frame_item) or (item = fill_item)
  669.            then begin
  670.                   if item = frame_item
  671.                   then begin
  672.                     b_frame := true;
  673.                     menu_check(menu, frame_item, true);
  674.                     menu_check(menu,  fill_item, false);
  675.                   end;
  676.                   if item = fill_item
  677.                   then begin
  678.                     b_frame := false;
  679.                     menu_check(menu, frame_item, false);
  680.                     menu_check(menu,  fill_item, true);
  681.                   end;
  682.                 end;
  683.  
  684.            if (item >= black_item) and (item <= green_item)
  685.            then begin
  686.                   menu_check(menu, black_item, false);
  687.                   menu_check(menu, white_item, false);
  688.                   menu_check(menu,   red_item, false);
  689.                   menu_check(menu, green_item, false);
  690.                   menu_check(menu, item, true);
  691.                   if item = black_item
  692.                   then cur_color := black;
  693.                   if item = white_item
  694.                   then cur_color := white;
  695.                   if item = red_item
  696.                   then cur_color := red;
  697.                   if item = green_item
  698.                   then cur_color := green;
  699.                   adjust_param;
  700.                 end;
  701.  
  702.            if (item = out_true_item) or (item = out_false_item)
  703.            then begin
  704.                   if item = out_true_item
  705.                   then begin
  706.                     menu_check(menu,  out_true_item, true);
  707.                     menu_check(menu, out_false_item, false);
  708.                     cur_outline := true;
  709.                     adjust_param;
  710.                   end;
  711.                   if item = out_false_item
  712.                   then begin
  713.                     menu_check(menu,  out_true_item, false);
  714.                     menu_check(menu, out_false_item, true);
  715.                     cur_outline := false;
  716.                     adjust_param;
  717.                   end;
  718.                 end;
  719.  
  720.            if item >= replace_item
  721.            then begin
  722.                   menu_check(menu, replace_item, false);
  723.                   menu_check(menu,  transp_item, false);
  724.                   menu_check(menu,     xor_item, false);
  725.                   menu_check(menu, reverse_item, false);
  726.                   menu_check(menu, item, true);
  727.                   if item = replace_item
  728.                   then cur_draw_mode := 1;
  729.                   if item = transp_item
  730.                   then cur_draw_mode := 2;
  731.                   if item = xor_item
  732.                   then cur_draw_mode := 3;
  733.                   if item = reverse_item
  734.                   then cur_draw_mode := 4;
  735.                   adjust_param;
  736.                 end;
  737. end;
  738.  
  739. procedure SET_TEXT_TITLE(item : integer);
  740. begin
  741.         if item = normal_item
  742.         then menu_check(menu,  normal_item, switch(b_normal));
  743.         if item = bold_item
  744.         then menu_check(menu,    bold_item, switch(b_bold));
  745.         if item = italic_item
  746.         then menu_check(menu,  italic_item, switch(b_italic));
  747.         if item = under_item
  748.         then menu_check(menu,  under_item, switch(b_under));
  749.         if item = outline_item
  750.         then menu_check(menu,  outline_item, switch(b_outline));
  751.         if item = shadow_item
  752.         then menu_check(menu,  shadow_item, switch(b_shadow));
  753.  
  754.         cur_text_style := 0;
  755.         if b_normal
  756.         then cur_text_style := cur_text_style|normal;
  757.         if b_bold
  758.         then cur_text_style := cur_text_style|thickened;
  759.         if b_italic
  760.         then cur_text_style := cur_text_style|slanted;
  761.         if b_under
  762.         then cur_text_style := cur_text_style|underlined;
  763.         if b_outline
  764.         then cur_text_style := cur_text_style|outlined;
  765.         if b_shadow
  766.         then cur_text_style := cur_text_style|shadowed;
  767.  
  768.         text_style(cur_text_style);
  769. end;
  770.  
  771. procedure SET_LINE_TITLE(item : integer);
  772. begin
  773.         menu_check(menu,    solid_item, false);
  774.         menu_check(menu, longdash_item, false);
  775.         menu_check(menu,     dots_item, false);
  776.         menu_check(menu,    ddots_item, false);
  777.         menu_check(menu,     dash_item, false);
  778.         menu_check(menu,      ddd_item, false);
  779.         menu_check(menu, item, true);
  780.         if item = solid_item
  781.         then cur_line_style := solid;
  782.         if item = longdash_item
  783.         then cur_line_style := longdash;
  784.         if item = dots_item
  785.         then cur_line_style := dotted;
  786.         if item = ddots_item
  787.         then cur_line_style := dashdot;
  788.         if item = dash_item
  789.         then cur_line_style := dashed;
  790.         if item = ddd_item
  791.         then cur_line_style := dashdotdot;
  792.  
  793.         adjust_param;
  794. end;
  795.  
  796. procedure SET_STYLE_TITLE(item : integer);
  797. begin
  798.            if item < n1_item
  799.            then begin
  800.                   menu_check(menu, m1_item, false);
  801.                   menu_check(menu, m2_item, false);
  802.                   menu_check(menu, m3_item, false);
  803.                   menu_check(menu, m4_item, false);
  804.                   menu_check(menu, m5_item, false);
  805.                   menu_check(menu, m6_item, false);
  806.                   menu_check(menu, m7_item, false);
  807.                   menu_check(menu, item, true);
  808.                   if item = m1_item
  809.                   then mul := 1;
  810.                   if item = m2_item
  811.                   then mul := 6;
  812.                   if item = m3_item
  813.                   then mul := 11;
  814.                   if item = m4_item
  815.                   then mul := 16;
  816.                   if item = m5_item
  817.                   then mul := 21;
  818.                   if item = m6_item
  819.                   then mul := 26;
  820.                   if item = m7_item
  821.                   then mul := 31;
  822.                   cur_paint_style := mul + mul_number;
  823.                   paint_style(cur_paint_style);
  824.                 end
  825.              else begin
  826.                   menu_check(menu, n1_item, false);
  827.                   menu_check(menu, n2_item, false);
  828.                   menu_check(menu, n3_item, false);
  829.                   menu_check(menu, n4_item, false);
  830.                   menu_check(menu, n5_item, false);
  831.                   menu_check(menu, item, true);
  832.                   if item = n1_item
  833.                   then mul_number := 0;
  834.                   if item = n2_item
  835.                   then mul_number := 1;
  836.                   if item = n3_item
  837.                   then mul_number := 2;
  838.                   if item = n4_item
  839.                   then mul_number := 3;
  840.                   if item = n5_item
  841.                   then mul_number := 4;
  842.                   cur_paint_style := mul + mul_number;
  843.                   paint_style(cur_paint_style);
  844.                   end;
  845. end;
  846.  
  847. procedure SET_WIND_TITLE(item : integer);
  848. var i, x, y, w, h : integer;
  849. begin
  850.         for i := 1 to 4 do
  851.            menu_check(menu, wind_item[i], false);
  852.         menu_check(menu, item, true);
  853.  
  854.         if not (item = wind_item[act_window])
  855.         then begin
  856.                close_window(draw_window[act_window]);
  857.                for i := 1 to 4 do
  858.                  if item = wind_item[i]
  859.                  then act_window := i;
  860.                open_window ( draw_window[act_window], 0,0,0,0 );
  861.                screen_char_param( draw_window[act_window] );
  862.                clear_window( draw_window[act_window] );
  863.                work_rect( draw_window[act_window], x, y, w, h ) ;
  864.                set_clip( x, y, w, h ) ;
  865.                adjust_param;
  866.              end;
  867. end;
  868.  
  869. procedure INSERT_FIGURE;
  870. const factor = 30;
  871. var i : integer;
  872.  
  873.   procedure DO_ARROW (size : integer);
  874.   var destx, desty, diff : integer;
  875.   begin
  876.       destx := curx + (size * factor);
  877.       desty := cury;
  878.       diff := (factor * size) div 5;
  879.       line(curx, cury, destx, desty);
  880.       line(destx - diff, cury - diff, destx, desty);
  881.       line(destx - diff, cury + diff, destx, desty);
  882.       move_to(curx, cury);
  883.   end;
  884.  
  885. begin
  886.       for i := 1 to 3 do
  887.         if b_square[i]
  888.         then if b_frame
  889.              then frame_rect(curx, cury, factor*i, factor*i)
  890.              else paint_rect(curx, cury, factor*i, factor*i);
  891.       for i := 1 to 3 do
  892.         if b_pcircle[i]
  893.         then if b_frame
  894.              then frame_oval(curx, cury, factor*i div 2, factor*i div 2)
  895.              else paint_oval(curx, cury, factor*i div 2, factor*i div 2);
  896.       for i := 1 to 3 do
  897.         if b_arrow[i]
  898.         then do_arrow(i);
  899. end;
  900.  
  901. procedure TEXT_EVENT;
  902. type but_press = (left, right);
  903. var   i, which, key,
  904.       dummy, xm, ym  : integer ;
  905.       msg : Message_Buffer ;
  906.       finished : boolean;
  907.       letter : char;
  908.       start_text : boolean;
  909.       sentence : string;
  910. begin
  911.       i := 0;
  912.       row := first_row;
  913.       col := first_col;
  914.       start_text := true;
  915.  
  916.       finished := false;
  917.       while not finished do
  918.       begin
  919.         which := Get_Event( E_Message|E_keyboard|E_Button, 1,1,1,0,
  920.                       false, 0, 0, 0, 0, false, 0, 0, 0, 0,
  921.                       msg, key, dummy, dummy, xm, ym, dummy ) ;
  922.  
  923.         if which & E_Keyboard <> 0
  924.         then begin
  925.                if not start_text
  926.                then begin
  927.                       letter := decode_key(key);
  928.                       if letter in [ chr(ord(32))..chr(ord(127)) ]
  929.                       then begin
  930.                              draw_string(col,row,letter);
  931.                              col := col + char_width;
  932.                              { row := row + char_heigth;}
  933.                              i := i + 1;
  934.                              sentence[i] := letter;
  935.                            end
  936.                        else begin
  937.                               start_text := true;
  938.                               show_mouse;
  939.                             end;
  940.                      end;
  941.              end
  942.         else if which & E_Button <> 0
  943.              then begin
  944.                     if start_text
  945.                     then begin
  946.                            col := xm;
  947.                            row := ym;
  948.                            start_text := false;
  949.                            hide_mouse;
  950.                          end
  951.                     else begin
  952.                            start_text := true;
  953.                            finished := true;
  954.                            show_mouse;
  955.                          end;
  956.                   end
  957.              else if which & E_Message <> 0
  958.                   then if msg[0] = mn_selected
  959.                        then menu_normal(menu, msg[3]);
  960.  
  961.       end; { while }
  962.  
  963. end ; { text_event }
  964.  
  965.  
  966. procedure EXECUTE_ACTION(x, y : integer);
  967. var xval, yval : letter_num;
  968.     s : string;
  969.     samex, samey, r1, r2 : integer;
  970.     tempo1, tempo2 : real;
  971. begin
  972.         if b_showxy
  973.         then begin
  974.                text_color(black);
  975.                line_color(black);
  976.                draw_mode(1);
  977.                text_style(normal);
  978.  
  979.                int_to_str(x,xval);
  980.                int_to_str(y,yval);
  981.                s := concat('x=',xval,' y=',yval);
  982.                draw_string(screen_w - (12 * char_width), first_row, s);
  983.                adjust_param;
  984.              end;
  985.  
  986.         hide_mouse;
  987.  
  988.         case actions of
  989.           point_action :
  990.                        begin
  991.                          plot(x,y);
  992.                          plot(x+1,y);
  993.                          plot(x-1,y);
  994.                          plot(x,y+1);
  995.                          plot(x,y-1);
  996.                        end;
  997.           line_action :
  998.                       begin
  999.                         if not start_figure
  1000.                         then begin
  1001.                                line(oldx, oldy, x, y);
  1002.                                oldx := x; oldy := y;
  1003.                              end
  1004.                         else start_figure := false;
  1005.                       end;
  1006.           rect_action :
  1007.                       begin
  1008.                         if not start_figure
  1009.                         then begin
  1010.                                draw_mode(xor_mode);
  1011.                                if b_frame
  1012.                                then frame_rect(oldx, oldy, samex, samey)
  1013.                                else paint_rect(oldx, oldy, samex, samey);
  1014.                              end
  1015.                         else start_figure := false;
  1016.  
  1017.                         draw_mode(replace_mode);
  1018.                         if b_frame
  1019.                         then frame_rect(oldx, oldy, x-oldx, y-oldy)
  1020.                         else paint_rect(oldx, oldy, x-oldx, y-oldy);
  1021.  
  1022.                         samex := x-oldx; samey := y-oldy;
  1023.                         draw_mode(cur_draw_mode);
  1024.                       end;
  1025.           rd_rect_action :
  1026.                       begin
  1027.                         if not start_figure
  1028.                         then begin
  1029.                                draw_mode(xor_mode);
  1030.                                if b_frame
  1031.                                then frame_round_rect(oldx, oldy, samex, samey)
  1032.                                else paint_round_rect(oldx, oldy, samex, samey);
  1033.                              end
  1034.                         else start_figure := false;
  1035.                         { interesting effects
  1036.                          frame_round_rect(x, y, oldx, oldy)
  1037.                           paint_round_rect(x, y, oldx, oldy); }
  1038.  
  1039.                         draw_mode(replace_mode);
  1040.                         if b_frame
  1041.                         then frame_round_rect(oldx, oldy, x-oldx, y-oldy)
  1042.                         else paint_round_rect(oldx, oldy, x-oldx, y-oldy);
  1043.  
  1044.                         samex := x-oldx; samey := y-oldy;
  1045.                         draw_mode(cur_draw_mode);
  1046.                       end;
  1047.           circle_action :
  1048.                       begin
  1049.  
  1050.                         if not start_figure
  1051.                         then begin
  1052.                                draw_mode(xor_mode);
  1053.                                if b_frame
  1054.                                then frame_oval(oldx, oldy, samex, samex)
  1055.                                else paint_oval(oldx, oldy, samex, samex);
  1056.                              end
  1057.                         else start_figure := false;
  1058.  
  1059.                         tempo1:= sqr( abs(x-oldx) ) + sqr( abs(y-oldy) );
  1060.                         tempo1 := abs ( tempo1 );
  1061.                         tempo2 := sqrt ( tempo1 );
  1062.                         r1 := trunc ( tempo2 );
  1063.                         draw_mode(replace_mode);
  1064.                         if b_frame
  1065.                         then frame_oval(oldx, oldy, r1, r1)
  1066.                         else paint_oval(oldx, oldy, r1, r1);
  1067.  
  1068.                         samex := r1;
  1069.                         draw_mode(cur_draw_mode);
  1070.                       end;
  1071.           text_action :
  1072.                       begin
  1073.                         show_mouse;
  1074.                         text_event;
  1075.                         hide_mouse;
  1076.                       end;
  1077.           preset_action :
  1078.                       begin
  1079.                        draw_string(curx, cury, preset_string);
  1080.                       end;
  1081.           insert_action :
  1082.                       begin
  1083.                         insert_figure;
  1084.                       end;
  1085.           nothing     :
  1086.                       begin
  1087.                       end;
  1088.         end; { case }
  1089.  
  1090.         show_mouse;
  1091. end;
  1092.  
  1093. procedure DISPATCH(title, item, x, y : integer);
  1094. begin
  1095.           if title = desk_title
  1096.           then alertbox(copyright);
  1097.           if title = file_title
  1098.           then set_file_title(item);
  1099.           if title = actions_title
  1100.           then set_actions_title(item, x, y);
  1101.           if title = predef_title
  1102.           then set_predef_title(item);
  1103.           if title = mode_title
  1104.           then set_mode_title(item);
  1105.           if title = text_title
  1106.           then set_text_title(item);
  1107.           if title = line_title
  1108.           then set_line_title(item);
  1109.           if title = paintstyle_title
  1110.           then set_style_title(item);
  1111.           if title = wind_title
  1112.           then set_wind_title(item);
  1113. end;
  1114.  
  1115. procedure EVENT_LOOP;
  1116. var   which, dummy  : integer;
  1117.       finished      : boolean;
  1118.       msg           : message_buffer;
  1119. begin
  1120.       finished := false;
  1121.       while not finished do
  1122.       begin
  1123.         which := get_event( e_message|e_button, 1,1,1,0,
  1124.                       false, 0, 0, 0, 0, false, 0, 0, 0, 0,
  1125.                       msg, dummy, dummy, dummy, xm, ym, dummy ) ;
  1126.  
  1127.  
  1128.         if which & e_message <> 0
  1129.         then begin
  1130.                start_figure := true;
  1131.                if msg[0] = mn_selected
  1132.                then if ((msg[3] = file_title) and (msg[4] = quit_item))
  1133.                     then finished := true
  1134.                     else dispatch(msg[3], msg[4], xm, ym);
  1135.                menu_normal(menu, msg[3]);
  1136.              end
  1137.         else if which & e_button <> 0
  1138.              then begin
  1139.                       curx := xm; cury := ym;
  1140.                       if start_figure
  1141.                       then begin
  1142.                              oldx := xm;
  1143.                              oldy := ym;
  1144.                             end;
  1145.                       execute_action(xm, ym);
  1146.                   end
  1147.              else start_figure := true;
  1148.  
  1149.       end; { while }
  1150. end ; { event_loop }
  1151.  
  1152. BEGIN  { main }
  1153.     if init_gem >= 0 then
  1154.       begin
  1155.         hide_mouse;
  1156.         taologo;
  1157.         definitions;
  1158.         def_window;
  1159.         clear_screen;
  1160.         set_mouse( m_thin_cross );
  1161.         show_mouse;
  1162.         draw_menu( menu ) ;
  1163.         act_window := 1;
  1164.         open_window ( draw_window[act_window], 0,0,0,0 );
  1165.         screen_char_param( draw_window[act_window] );
  1166.         init_param;
  1167.         clear_window( draw_window[act_window] );
  1168.         work_rect( draw_window[act_window], x, y, w, h ) ;
  1169.         set_clip( x, y, w, h ) ;
  1170.  
  1171.         event_loop ;
  1172.  
  1173.         close_window( draw_window[act_window] );
  1174.         erase_menu( menu ) ;
  1175.         set_mouse( m_arrow );
  1176.         exit_gem ;
  1177.       end;
  1178. END.
  1179.